Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) _
    As Long
Private Const CSC_NAVIGATEFORWARD As Integer = 1
Private Const CSC_NAVIGATEBACK As Integer = 2

Private Const CB_FINDSTRING As Long = &H14C

Dim mbDontNavigateNow As Boolean
Private Minimized As FormWindowStateConstants

Public Sub ComboAutoComplete(ByRef SourceCtl As VB.ComboBox, _
    ByRef KeyAscii As Integer, ByRef LeftOffPos As Long)
  Dim iStart As Long
  Dim sSearchKey As String
  
  With SourceCtl
    'If text entered so far matches item(s) in the list, use autocomplete
    Select Case Chr$(KeyAscii)
      Case vbBack
        'Let backspace characters process as usual; otherwise try to match text
      Case Else
        If Chr$(KeyAscii) <> vbBack Then
          .SelText = Chr$(KeyAscii)
          
          iStart = .SelStart
          
          If LeftOffPos <> 0 Then
            .SelStart = LeftOffPos
            iStart = LeftOffPos
          End If
          
          sSearchKey = CStr(Left$(.Text, iStart))
          .ListIndex = SendMessage(.hWnd, CB_FINDSTRING, -1, _
              ByVal CStr(Left$(.Text, iStart)))
          
          If .ListIndex = -1 Then
            LeftOffPos = Len(sSearchKey)
          End If
          
          .SelStart = iStart
          .SelLength = Len(.Text)
          LeftOffPos = 0
          
          KeyAscii = 0
        End If
    End Select
  End With
End Sub

Private Sub brwWebBrowser_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    
    URL = cboAddress.Text
    
    If cboAddress.Text = "www.myspace.com" Or cboAddress.Text = "http://www.myspace.com" Or cboAddress.Text = "http://myspace.com" Or cboAddress.Text = "myspace.com" Then
        MsgBox "Access Denied! " & URL & " is blocked for bad stuff.", vbCritical
        Cancel = True
        Me.Caption = "Access Denied!" & " - My Web Browser" & Space(1) & App.Major & "." & App.Minor & "." & App.Revision
    ElseIf cboAddress.Text = "www.philywily.com" Or cboAddress.Text = "http://philywily.com" Or cboAddress.Text = "http://www.philywily.com" Or cboAddress.Text = "philywily.com" Then
        MsgBox "Access Denied! " & URL & " is blocked for going through websites.", vbCritical
        Cancel = True
        Me.Caption = "Access Denied!" & " - My Web Browser" & Space(1) & App.Major & "." & App.Minor & "." & App.Revision
    End If
End Sub

Private Sub brwWebBrowser_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)

      Select Case Command
         Case CSC_NAVIGATEBACK
            tlbNavigate.Buttons(1).Enabled = Enable
         Case CSC_NAVIGATEFORWARD
            tlbNavigate.Buttons(2).Enabled = Enable
      End Select
      
End Sub

Private Sub brwWebBrowser_DownloadComplete()
    On Error Resume Next
    Me.Caption = brwWebBrowser.LocationName & " - My Web Browser" & Space(1) & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub brwWebBrowser_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    Dim i As Integer
    Dim bFound As Boolean
    
    Me.Caption = brwWebBrowser.LocationName & " - My Web Browser" & Space(1) & App.Major & "." & App.Minor & "." & App.Revision
    For i = 0 To cboAddress.ListCount - 1
        If cboAddress.List(i) = brwWebBrowser.LocationURL Then
            bFound = True
            Exit For
        End If
    Next i
    mbDontNavigateNow = True
    cboAddress.AddItem brwWebBrowser.LocationURL, 0
    cboAddress.ListIndex = 0
    mbDontNavigateNow = False
    stbStatus.Panels(1).Text = "Waiting for " & cboAddress.Text & " ..."
End Sub

Private Function IsPopupWindow() As Boolean
    On Error Resume Next
    If brwWebBrowser.Document.activeElement.tagName = "BODY" Or brwWebBrowser.Document.activeElement.tagName = "IFRAME" Then
        IsPopupWindow = True
    Else
        IsPopupWindow = False
    End If
End Function

Private Sub brwWebBrowser_NewWindow2(ppDisp As Object, Cancel As Boolean)
    On Error Resume Next
    Dim frmNW As frmApp
    
    Cancel = IsPopupWindow
    
    Set frmNW = New frmApp
    frmNW.brwWebBrowser.RegisterAsBrowser = True
    Set ppDisp = frmNW.brwWebBrowser.object
    frmNW.Show
    frmNW.Caption = frmWebBrowser.brwWebBrowser.LocationName & " - My Web Browser" & Space(1) & App.Major & "." & App.Minor & "." & App.Revision
    Popups.Visible = True And False
End Sub
Private Function Popups() As frmApp
    Dim frmAds As frmApp
    Dim ppDisp As Object
    Dim Cancel As Boolean
    
    If Cancel = False Then
        Set frmAds = New frmApp
        Set ppDisp = frmAds.brwWebBrowser.object
        frmAds.Visible = False And False
        Unload frmAds
    End If
End Function

Private Sub cboAddress_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyReturn Then
        brwWebBrowser.Navigate (cboAddress.Text)
    End If
    Static iLeftOff As Long
    
    ComboAutoComplete cboAddress, KeyAscii, iLeftOff
End Sub

Private Sub Form_Load()
    brwWebBrowser.Silent = True
    brwWebBrowser.GoHome
    mnuAbout.Caption = "&About " & App.Title
    Timer1.Interval = 1000
    stbStatus.Panels(2).Text = Time
    stbStatus.Panels(3).Text = Date
End Sub

Private Sub Form_Resize()
    Dim laststate As String

    laststate = Me.WindowState
    If Me.WindowState <> vbMinimized Then
       brwWebBrowser.Height = Me.Height - 2400
       brwWebBrowser.Width = Me.Width - 100
    End If
End Sub

Private Sub cmdGo_Click()
    brwWebBrowser.Navigate (cboAddress.Text)
End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show
End Sub

Private Sub mnuCopy_Click()
    brwWebBrowser.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, Null, Null
End Sub

Private Sub mnuCut_Click()
    brwWebBrowser.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT, Null, Null
End Sub

Private Sub mnuExit_Click()
    Me.Visible = False
    Unload Me
End Sub

Private Sub mnuFind_Click()
    brwWebBrowser.ExecWB OLECMDID_FIND, OLECMDEXECOPT_DODEFAULT, Null, Null
End Sub

Private Sub mnuFindOnWeb_Click()
    frmSearchBox.Show
End Sub

Private Sub mnuNew_Click()
    On Error Resume Next
    Dim frmNW As frmWebBrowser
    Dim ppDisp As Object
    Dim Cancel As Boolean
    
    Cancel = IsPopupWindow
    
    Set frmNW = New frmWebBrowser
    frmNW.brwWebBrowser.RegisterAsBrowser = True
    Set ppDisp = frmNW.brwWebBrowser.object
    frmNW.Show
    frmNW.Caption = frmWebBrowser.brwWebBrowser.LocationName & " - My Web Browser" & Space(1) & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuOpen_Click()
    On Error Resume Next
    brwWebBrowser.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_PROMPTUSER, Null, Null
    With cmnInternet
        .DialogTitle = "Open File(s) onto Web Browser"
        .Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & "All Supported Picture formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & "*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & "Text formats (*.txt;*.doc)|*.txt;*.doc|" & "All files (*.*)|*.*|"
        .ShowOpen
        .Flags = 5
    End With
    brwWebBrowser.Navigate2 cmnInternet.FileName
End Sub

Private Sub mnuPaste_Click()
    brwWebBrowser.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT, Null, Null
End Sub

Private Sub mnuSave_Click()
    brwWebBrowser.ExecWB OLECMDID_SAVE, OLECMDEXECOPT_PROMPTUSER, Null, Null
    With cmnInternet
        .DialogTitle = "Save Files from Website"
        .Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & "All Supported Picture formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & "*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & "Text formats (*.txt;*.doc)|*.txt;*.doc|" & "All files (*.*)|*.*|"
        .ShowSave
        .Flags = 5
    End With
End Sub

Private Sub mnuSaveAs_Click()
    brwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub

Private Sub mnuSelectAll_Click()
    brwWebBrowser.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, Null, Null
End Sub

Private Sub mnuSmaller_Click()
    brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 3), Null
End Sub

Private Sub mnuMedium_Click()
    brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 2), Null
End Sub

Private Sub mnuLarger_Click()
    brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 1), Null
End Sub

Private Sub mnuLargest_Click()
    brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 0), Null
End Sub


Private Sub mnuInternetOptions_Click()
    Dim lRet As Long
    Dim ShowInetProperties As Boolean
        
        lRet = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
    
    ShowInetProperties = lRet > 0
End Sub

Private Sub mnuPrintPreview_Click()
    brwWebBrowser.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub

Private Sub mnuPageSetup_Click()
    brwWebBrowser.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub

Private Sub mnuPrint_Click()
    brwWebBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub

Private Sub mnuSmallest_Click()
    brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 4), Null
End Sub

Private Sub Timer1_Timer()
    Timer1.Interval = 1000
    stbStatus.Panels(2).Text = Time
End Sub

Private Sub tlbNavigate_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    
        Case "Back"
            brwWebBrowser.GoBack
        Case "Forward"
            brwWebBrowser.GoForward
        Case "Stop"
            brwWebBrowser.Stop
        Case "Refresh"
            brwWebBrowser.Refresh
        Case "Search"
            brwWebBrowser.GoSearch
        Case "Home"
            brwWebBrowser.GoHome
        Case "Print"
            brwWebBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, Null, Null
    End Select
End Sub

Private Sub brwWebBrowser_StatusTextChange(ByVal Text As String)
    stbStatus.Panels(1).Text = Text
End Sub
